perm filename QUEENS.FAI[1,BGB]1 blob sn#015520 filedate 1972-12-06 generic text, type T, neo UTF8
00100	TITLE QUEENS PUZZLE PROBLEM  -  1 DECEMBER 1972.
00200	
00300	;ACCUMULATORS
00400	
00500		Q1←7
00600		Q2←10
00700		R←11	↔	ROW←12
00800		C←13	↔	COL←14
00900		K←14
01000		CNT←15
01100		I←16
01200		J←17
01300	
01400	; ALTERNATE PDP-10 MNEMONICS.
01500	
01600		OPDEF LIP[HLR]↔OPDEF LAP[HRR]↔OPDEF DIP[HRLM]
01700		OPDEF DAP[HRRM]↔OPDEF CAR[HLRZ]↔OPDEF CDR[HRRZ]
01800		OPDEF DIPZ[HRLZM]↔OPDEF DAPZ[HRRZM]↔OPDEF ZIP[HRRZS]
01900		OPDEF ZAP[HLLZS]↔OPDEF WIP[HRROS]↔OPDEF WAP[HRRZS]
02000		OPDEF NIP[HLRE]↔OPDEF NAP[HRRE]↔OPDEF NIM[HRREI]
02100		OPDEF LAC[MOVE]↔OPDEF DAC[MOVEM]↔OPDEF SLAC[MOVS]
02200		OPDEF GO[JRST]↔OPDEF LACI[MOVEI]↔OPDEF SLACI[MOVSI]
02300		OPDEF LAPI[HRRI]↔OPDEF LIPI[HRLI]↔OPDEF LACN[MOVN]
02400	
02500	;YE VERY OLDE TYPE OUT DECIMAL NUMBER ROUTINE.
02600	
02700	ONUM:	IDIVI 1,12↔PUSH 17,2↔SKIPE 1↔PUSHJ 17,ONUM
02800		POP 17,1↔ADDI 1,60↔OUTCHR 1↔POPJ 17,
02900	
03000	PDL:	BLOCK 100
     

00100	;TABLES OF THE GROUP OF SYMMETRIES OF A SQUARE.
00200	
00300	
00400	;T0:
00500		;00 ;01 ;02 ;03 ;04 ;05 ;06 ;07 
00600		;10 ;11 ;12 ;13 ;14 ;15 ;16 ;17 
00700		;20 ;21 ;22 ;23 ;24 ;25 ;26 ;27 
00800		;30 ;31 ;32 ;33 ;34 ;35 ;36 ;37 
00900		;40 ;41 ;42 ;43 ;44 ;45 ;46 ;47 
01000		;50 ;51 ;52 ;53 ;54 ;55 ;56 ;57 
01100		;60 ;61 ;62 ;63 ;64 ;65 ;66 ;67 
01200		;70 ;71 ;72 ;73 ;74 ;75 ;76 ;77 
01300	
01400	T1:	 
01500		 07 ↔06 ↔05 ↔04 ↔03 ↔02 ↔01 ↔00 
01600		 17 ↔16 ↔15 ↔14 ↔13 ↔12 ↔11 ↔10 
01700		 27 ↔26 ↔25 ↔24 ↔23 ↔22 ↔21 ↔20 
01800		 37 ↔36 ↔35 ↔34 ↔33 ↔32 ↔31 ↔30 
01900		 47 ↔46 ↔45 ↔44 ↔43 ↔42 ↔41 ↔40 
02000		 57 ↔56 ↔55 ↔54 ↔53 ↔52 ↔51 ↔50 
02100		 67 ↔66 ↔65 ↔64 ↔63 ↔62 ↔61 ↔60 
02200		 77 ↔76 ↔75 ↔74 ↔73 ↔72 ↔71 ↔70 
02300	
02400	T2:
02500		 70 ↔71 ↔72 ↔73 ↔74 ↔75 ↔76 ↔77 
02600		 60 ↔61 ↔62 ↔63 ↔64 ↔65 ↔66 ↔67 
02700		 50 ↔51 ↔52 ↔53 ↔54 ↔55 ↔56 ↔57 
02800		 40 ↔41 ↔42 ↔43 ↔44 ↔45 ↔46 ↔47 
02900		 30 ↔31 ↔32 ↔33 ↔34 ↔35 ↔36 ↔37 
03000		 20 ↔21 ↔22 ↔23 ↔24 ↔25 ↔26 ↔27 
03100		 10 ↔11 ↔12 ↔13 ↔14 ↔15 ↔16 ↔17 
03200		 00 ↔01 ↔02 ↔03 ↔04 ↔05 ↔06 ↔07 
03300	
03400	T3:
03500		 77 ↔76 ↔75 ↔74 ↔73 ↔72 ↔71 ↔70 
03600		 67 ↔66 ↔65 ↔64 ↔63 ↔62 ↔61 ↔60 
03700		 57 ↔56 ↔55 ↔54 ↔53 ↔52 ↔51 ↔50 
03800		 47 ↔46 ↔45 ↔44 ↔43 ↔42 ↔41 ↔40 
03900		 37 ↔36 ↔35 ↔34 ↔33 ↔32 ↔31 ↔30 
04000		 27 ↔26 ↔25 ↔24 ↔23 ↔22 ↔21 ↔20 
04100		 17 ↔16 ↔15 ↔14 ↔13 ↔12 ↔11 ↔10 
04200		 07 ↔06 ↔05 ↔04 ↔03 ↔02 ↔01 ↔00 
04300	
     

00100	T4:
00200		70 ↔60 ↔50 ↔40 ↔30 ↔20 ↔10 ↔00 
00300		71 ↔61 ↔51 ↔41 ↔31 ↔21 ↔11 ↔01 
00400		72 ↔62 ↔52 ↔42 ↔32 ↔22 ↔12 ↔02 
00500		73 ↔63 ↔53 ↔43 ↔33 ↔23 ↔13 ↔03 
00600		74 ↔64 ↔54 ↔44 ↔34 ↔24 ↔14 ↔04 
00700		75 ↔65 ↔55 ↔45 ↔35 ↔25 ↔15 ↔05 
00800		76 ↔66 ↔56 ↔46 ↔36 ↔26 ↔16 ↔06 
00900		77 ↔67 ↔57 ↔47 ↔37 ↔27 ↔17 ↔07 
01000	
01100	T5:
01200		77 ↔67 ↔57 ↔47 ↔37 ↔27 ↔17 ↔07 
01300		76 ↔66 ↔56 ↔46 ↔36 ↔26 ↔16 ↔06 
01400		75 ↔65 ↔55 ↔45 ↔35 ↔25 ↔15 ↔05 
01500		74 ↔64 ↔54 ↔44 ↔34 ↔24 ↔14 ↔04 
01600		73 ↔63 ↔53 ↔43 ↔33 ↔23 ↔13 ↔03 
01700		72 ↔62 ↔52 ↔42 ↔32 ↔22 ↔12 ↔02 
01800		71 ↔61 ↔51 ↔41 ↔31 ↔21 ↔11 ↔01 
01900		70 ↔60 ↔50 ↔40 ↔30 ↔20 ↔10 ↔00 
02000	
02100	T6:
02200		00 ↔10 ↔20 ↔30 ↔40 ↔50 ↔60 ↔70 
02300		01 ↔11 ↔21 ↔31 ↔41 ↔51 ↔61 ↔71 
02400		02 ↔12 ↔22 ↔32 ↔42 ↔52 ↔62 ↔72 
02500		03 ↔13 ↔23 ↔33 ↔43 ↔53 ↔63 ↔73 
02600		04 ↔14 ↔24 ↔34 ↔44 ↔54 ↔64 ↔74 
02700		05 ↔15 ↔25 ↔35 ↔45 ↔55 ↔65 ↔75 
02800		06 ↔16 ↔26 ↔36 ↔46 ↔56 ↔66 ↔76 
02900		07 ↔17 ↔27 ↔37 ↔47 ↔57 ↔67 ↔77 
03000	
03100	T7:
03200		07 ↔17 ↔27 ↔37 ↔47 ↔57 ↔67 ↔77 
03300		06 ↔16 ↔26 ↔36 ↔46 ↔56 ↔66 ↔76 
03400		05 ↔15 ↔25 ↔35 ↔45 ↔55 ↔65 ↔75 
03500		04 ↔14 ↔24 ↔34 ↔44 ↔54 ↔64 ↔74 
03600		03 ↔13 ↔23 ↔33 ↔43 ↔53 ↔63 ↔73 
03700		02 ↔12 ↔22 ↔32 ↔42 ↔52 ↔62 ↔72 
03800		01 ↔11 ↔21 ↔31 ↔41 ↔51 ↔61 ↔71 
03900		00 ↔10 ↔20 ↔30 ↔40 ↔50 ↔60 ↔70 
     

00100	;One Queen Attack Table  -  64 boards.
00200		QAT1:	BLOCK =64
00300		QAT2:	BLOCK =64
00400	
00500	;Two Queens Attack Table  -  2016 boards.
00600		QQAT1:	BLOCK =2016
00700		QQAT2:	BLOCK =2016
00800		QQL1:	BLOCK =2016
00900		QQL2:	BLOCK =2016
01000	
01100	;Scratch Attack Table - 2016 boards.
01200		SAT1:	BLOCK =2016
01300		SAT2:	BLOCK =2016
01400		SAT3:	0
01500	
01600	;Column attack table - 8 boards.
01700	CAT:	1001001001B28↔1001001001B28	;COL 0.
01800		1001001001B29↔1001001001B29	;COL 1.
01900		1001001001B30↔1001001001B30	;COL 2.
02000		1001001001B31↔1001001001B31	;COL 3.
02100		1001001001B32↔1001001001B32	;COL 4.
02200		1001001001B33↔1001001001B33	;COL 5.
02300		1001001001B34↔1001001001B34	;COL 6.
02400		1001001001B35↔1001001001B35	;COL 7.
02500	
02600	;Row Attack Table - 8 boards.
02700	RAT:	377B8↔0		;ROW 0.
02800		377B17↔0	;ROW 1.
02900		377B26↔0	;ROW 2.
03000		377B35↔0	;ROW 3.
03100		0↔377B8		;ROW 4.
03200		0↔377B17	;ROW 5.
03300		0↔377B26	;ROW 6.
03400		0↔377B35	;ROW 7.
03500	
03600	;Byte pointer to column 7 of each row.
03700	ROWPTR:	POINT 1,Q1,8 ↔ POINT 1,Q1,17	;ROWS 0 & 1.
03800		POINT 1,Q1,26↔ POINT 1,Q1,35	;ROWS 2 & 3.
03900		POINT 1,Q2,8 ↔ POINT 1,Q2,17	;ROWS 4 & 5.
04000		POINT 1,Q2,26↔ POINT 1,Q2,35	;ROWS 6 & 7.
04100	
04200	;Byte pointer P-bits of each column.
04300	COLPTR:	7B5↔6B5↔5B5↔4B5
04400		3B5↔2B5↔1B5↔0
04500	
04600	;Make a bit pointer to a square of the board.
04700		DEFINE MKPTR{LAC 1,ROWPTR(R)↔ADD 1,COLPTR(C)}
     

00100	;MAKE ONE QUEEN ATTACK TABLE.
00200	MKQAT:	0
00300		LACI I,100↔LACI ROW,7↔LACI COL,7↔SOS I
00400		LSH ROW,1↔LAC Q1,RAT(ROW)↔LAC Q2,RAT+1(ROW)↔LSH ROW,-1
00500		LSH COL,1↔IOR Q1,CAT(COL)↔IOR Q2,CAT+1(COL)↔LSH COL,-1
00600		LACI 1
00700		LAC R,ROW↔LAC C,COL↔JSR NE
00800		LAC R,ROW↔LAC C,COL↔JSR NW
00900		LAC R,ROW↔LAC C,COL↔JSR SW
01000		LAC R,ROW↔LAC C,COL↔JSR SE
01100		LAC R,ROW↔LAC C,COL↔MKPTR↔SETZ↔DPB 0,1
01200		DAC Q1,QAT1(I)↔DAC Q2,QAT2(I)
01300		SOJGE COL,MKQAT+4
01400		SOJGE ROW,MKQAT+3
01500		GO @MKQAT
01600	
01700	;NORTH EAST ATTACK: R-1,C+1.
01800	NE:	0
01900		SOSGE R↔GO@NE
02000		AOS C↔CAIN C,8↔GO @NE
02100		MKPTR↔DPB 0,1↔GO NE+1
02200	
02300	;NORTH WEST ATTACK: R-1,C-1.
02400	NW:	0
02500		SOSGE R↔GO@NW
02600		SOSGE C↔GO@NW
02700		MKPTR↔DPB 0,1↔GO NW+1
02800	
02900	;SOUTH WEST ATTACK: R+1,C-1.
03000	SW:	0
03100		AOS R↔CAIN R,8↔GO@SW
03200		SOSGE C↔GO@SW
03300		MKPTR↔DPB 0,1↔GO SW+1
03400	
03500	;SOUTH EAST ATTACK: R+1,C+1.
03600	SE:	0
03700		AOS R↔CAIN R,8↔GO@SE
03800		AOS C↔CAIN C,8↔GO@SE
03900		MKPTR↔DPB 0,1↔GO SE+1
04000	
     

00100	;MAKE TWO QUEEN ATTACK TABLE - UNORDERED PAIR OF QUEENS.
00200	MKQQAT:	0
00300		SETZ I,
00400		SETZ 1,
00500	L1:	SETZ 2,
00600	L2:	CAML 1,2↔GO L3
00700		LAC QAT1(1)↔IOR QAT1(2)↔DAC QQAT1(I)
00800		LAC QAT2(1)↔IOR QAT2(2)↔DAC QQAT2(I)
00900		DAC 1,QQL1(I)
01000		DAC 2,QQL2(I)
01100		AOS I
01200	L3:	AOS 2↔CAIE 2,100↔GO L2
01300		AOS 1↔CAIE 1,100↔GO L1
01400		GO @MKQQAT
01500	
01600	;MAKE A PARTIAL THREE QUEEN ATTACK TABLE.
01700	;ARGUMENT  -  THIRD QUEEN'S POSITION NUMBER  -  AC1.
01800	MK3QAT:0
01900		LAC[XWD QQAT1,SAT1]↔BLT SAT3-1
02000		LAC Q1,QAT1(K)
02100		LAC Q2,QAT2(K)
02200		IOR Q1,[400400400400]	;SET EMPTY BITS.
02300		IOR Q2,[400400400400]
02400		LACI I,=2016
02500		IORM Q1,SAT1(I)
02600		IORM Q2,SAT2(I)
02700		SOJGE I,.-2
02800		GO @MK3QAT
     

00100	;MAKE FIVE QUEEN ATTACKS - RECORD FULL BOARD COVERAGE.
00200	MK5QAT:	0
00300		SETZ CNT,
00400		SETZ I,
00500	M1:	SETZ J,
00600		CAML K,QQL1(I)↔GO M4
00700		LAC  0,QQL2(I)
00800	M2:	CAML 0,QQL1(J)↔GO M3
00900		SETCM Q1,SAT1(I)↔ANDCM Q1,SAT1(J)↔JUMPN Q1,M3
01000		SETCM Q2,SAT2(I)↔ANDCM Q2,SAT2(J)↔JUMPN Q2,M3
01100	
01200	;DETECT SOLUTIONS THAT ARE REDUNDANT BECAUSE THEY CAN BE
01300	;MAPPED INTO A FORM WITH A QUEEN LESS THAN K.
01400		LAC 1,K↔LSH 1,6
01500		IOR 1,QQL1(I)↔JSR SYMM↔LSH 1,6
01600		IOR 1,QQL2(I)↔JSR SYMM↔LSH 1,6
01700		IOR 1,QQL1(J)↔JSR SYMM↔LSH 1,6
01800		IOR 1,QQL2(J)↔JSR SYMM
01900	
02000	;DETECT SOLUTIONS THAT ARE REDUNDANT BECAUSE THEY MAP
02100	;A QUEEN INTO POSITION K AND HAVE ALREADY BEEN RECORDED.
02200		JUMPE CNT,M5↔DAC 1,10
02300		JSR SYMM2↔ROT 1,-6
02400		JSR SYMM2↔ROT 1,-6
02500		JSR SYMM2↔ROT 1,-6
02600		JSR SYMM2↔LSH 1,-6
02700		JSR SYMM2↔LAC 1,10
02800	
02900	;OUTPUT A SOLUTION TO THE BUFFER.
03000	M5:	AOS 2,SUBTOTAL#
03100		AOS CNT
03200	M0:	DAC 1,BUFFER(2)
03300	
03400	M3:	AOS J↔CAIE J,=2016↔GO M2
03500	M4:	AOS I↔CAIE I,=2016↔GO M1
03600		GO @MK5QAT
03700	
03800	BUFFER:	BLOCK 5000
     

00100	;IGNORE REDUNDANT SOLUTIONS DUE TO BOARD SYMMETRIES.
00200	; π/2 ROTATIONS; DIAGONAL, HORIZONTAL & VERTICAL REFLECTIONS.
00300	SYMM:	0
00400		LAC 2,1
00500		ANDI 2,77
00600		FOR @' I←1,7{
00700		CAMLE K,T'I(2)↔GO M3}
00800		GO@SYMM
00900	SYMM2:	0
01000		LAC 2,1
01100		ANDI 2,77
01200		FOR @' I←1,7{
01300		CAMN K,T'I(2)↔JSP 12,SYMT'I}
01400		GO @SYMM2
01500	
01600	;TRANSFORM THE SOLUTION IN AC-10.
01700		FOR @' I←1,7{
01800	SYMT'I:
01900		LAC 11,[POINT 6,10,5]
02000		ILDB 3,11↔LAC 3,T'I(3)
02100		ILDB 4,11↔LAC 4,T'I(4)
02200		ILDB 5,11↔LAC 5,T'I(5)
02300		ILDB 6,11↔LAC 6,T'I(6)
02400		ILDB 7,11↔LAC 7,T'I(7)
02500		GO SYM3}
02600	
02700	;GET THE TRANSFORMED SOLUTION INTO CANONICAL FORM.
02800	SYM3:	CAML 3,4↔EXCH 3,4↔CAML 3,5↔EXCH 3,5
02900		CAML 3,6↔EXCH 3,6↔CAML 3,7↔EXCH 3,7
03000		CAML 4,5↔EXCH 4,5
03100		CAML 4,6↔EXCH 4,6↔CAML 4,7↔EXCH 4,7
03200		CAML 5,6↔EXCH 5,6↔CAML 5,7↔EXCH 5,7
03300		CAML 6,7↔EXCH 6,7
03400	
03500		LSH 3,6↔IOR 3,4↔LSH 3,6↔IOR 3,5
03600		LSH 3,6↔IOR 3,6↔LSH 3,6↔IOR 3,7
03700	
03800	;SEARCH BACK THROUGH THE BUFFER FOR A MATCH.
03900		LAC 4,CNT↔LAC 5,SUBTOTAL
04000		CAMN 3,BUFFER(5)↔GO M3↔SOS 5
04100		SOJG 4,.-3↔GO(12)
     

00100	;MAIN EXECUTION.
00200	SA:	JSR MKQAT
00300		JSR MKQQAT
00400		SETZM TOTAL#
00500	
00600	DEFINE CALLQ $(Q){
00700		LACI K,Q↔JSR MK3QAT↔JSR MK5QAT
00800		DAC CNT,CNT$Q#↔ADDM CNT,TOTAL
00900		JSR OUTNUM}
01000		
01100		CALLQ(23)
01200		CALLQ(22)
01300		CALLQ(13)
01400		CALLQ(12)
01500		CALLQ(11)
01600		CALLQ(03)
01700		CALLQ(02)
01800		CALLQ(01)
01900		CALLQ(00)
02000	
02100	;OUTPUT FILE OF SOLUTIONS.
02200		LAC SUBTOTAL↔DAC BUFFER
02300		INIT 1,17↔SIXBIT/DSK/↔0↔HALT
02400		ENTER 1,[SIXBIT/QFILE/↔0↔0↔0]↔JFCL
02500		OUT 1,[IOWD 5000,BUFFER↔0]↔JFCL↔RELEASE 1,
02600		CALLI 12
02700	
02800	OUTNUM:	0
02900		OUTSTR[BYTE(7)15,12]↔LACI 17,PDL
03000		LAC 1,CNT↔PUSHJ 17,ONUM↔OUTCHR[9]
03100		LAC 1,SUBTOTAL↔PUSHJ 17,ONUM↔OUTCHR[9]
03200		LAC 1,TOTAL↔PUSHJ 17,ONUM
03300		GO @OUTNUM
03400	
03500	END SA